home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tvtoys04.zip / TOYAPP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-18  |  9KB  |  324 lines
  1. (***************************************************************************
  2.   TToyApp unit
  3.   Inherit this for easy access to TVToys' Help and Video functions
  4.   PJB November 6, 1993, Internet mail to d91-pbr@nada.kth.se
  5.   Copyright PJB 1993, All Rights Reserved.
  6.   Free source, use at your own risk.
  7.   If modified, please state so if you pass this around.
  8.  
  9.   All commands and help contexts used in this file are defined in
  10.   TOYPREFS.PAS, but you can override the help contexts with your own
  11.   HELPCTX.PAS (see HCFILE and TOYPREFS).
  12.  
  13.   RegisterHelpFile is called automatically.
  14.  
  15.   Set ExeFileName and HelpFileName to their corresponding values to
  16.   make the Help work. See HELPTEST.PAS for an example.
  17.  
  18.   ExeFileName is only needed for DOS 1.x and 2.x compatibility, and
  19.   HelpFileName is only needed if you don't define ExeHelp (ExeHelp
  20.   assumes DOS 3+ compatibility).
  21.  
  22.   If you use this unit, ALL the help code will be linked into your
  23.   application. You need two IFDEFs to avoid that. Most of the video
  24.   code is also linked in.
  25.  
  26. ***************************************************************************)
  27. unit ToyApp;
  28.  
  29. {$I toyCfg}
  30.  
  31. {$B-,O+,X+}
  32.  
  33. interface
  34.  
  35.   uses
  36.     Dos,
  37.     App, Dialogs, Drivers, Memory, Menus, MsgBox, Objects, Views,
  38.    {$IFDEF UseNewMouse}
  39.     NewMouse,
  40.    {$ENDIF}
  41.    {$IFDEF ExeHelp}
  42.     ExeStrm,
  43.    {$ENDIF}
  44.     toyPrefs, {$I hcFile}
  45.     HelpFile, toyUtils, TVVideo, Video;
  46.  
  47.   type
  48.     PToyApp = ^TToyApp;
  49.     TToyApp =
  50.       object (TApplication)
  51.         ExeFileName    : PathStr;
  52.         HelpFileName   : PathStr;
  53.         HelpInUse      : Boolean;
  54.  
  55.         DosVideoState  : VideoState;
  56.  
  57.         constructor Init;
  58.         destructor  Done; virtual;
  59.         procedure DosShell;
  60.         function  ExeDir:PathStr;
  61.         procedure GetEvent(var Event:TEvent); virtual;
  62.         function  GetPalette:PPalette; virtual;
  63.         procedure HandleEvent(var Event:TEvent); virtual;
  64.         procedure LoadPalette(var S:TStream);
  65.         procedure ShowHelp(aHelpCtx:word);
  66.         procedure StorePalette(var S:TStream);
  67.       end;
  68.  
  69. implementation
  70.  
  71.  
  72.   (*******************************************************************
  73.     Init
  74.   *******************************************************************)
  75.   constructor TToyApp.Init;
  76.     var
  77.       InitState : VideoState;
  78.   begin
  79.     (* Always start with this command *)
  80.     CheckVideoType;
  81.  
  82.     InitState.Save;             (* Use temporary variable since... *)
  83.     inherited Init;             (* ... this zeros the whole object *)
  84.     DosVideoState:=InitState;
  85.  
  86.     (* Set ScreenMode to a value closer to reality (for V7,VESA) *)
  87.     ScreenMode:=GetSpecialVideoMode;
  88.  
  89.     RegisterHelpFile;           (* Save us some trouble *)
  90.   end;
  91.  
  92.  
  93.   (*******************************************************************
  94.     Restore initial video mode
  95.   *******************************************************************)
  96.   destructor TToyApp.Done;
  97.   begin
  98.     TVVideo.PreventModeSwitch;
  99.     inherited Done;
  100.     DosVideoState.Restore;
  101.   end;
  102.  
  103.  
  104.   (*******************************************************************
  105.     New DosShell procedure
  106.   *******************************************************************)
  107.   procedure TToyApp.DosShell;
  108.     var
  109.       TVVideoState : VideoState;
  110.   begin
  111.     DoneSysError;
  112.     DoneEvents;
  113.    {$IFDEF UseNewMouse}
  114.     UseNewMouse(False);
  115.    {$ENDIF}
  116.  
  117.     TVVideoState.Save;
  118.     DosVideoState.Restore;
  119.  
  120.     DoneDosMem;
  121.     WriteShellMsg;
  122.     SwapVectors;
  123.     Exec(GetEnv('COMSPEC'), '');
  124.     SwapVectors;
  125.     InitDosMem;
  126.  
  127.     DosVideoState.Save;
  128.     TVVideoState.Restore;
  129.     VideoModeChanged;
  130.  
  131.    {$IFDEF UseNewMouse}
  132.     UseNewMouse(True);
  133.    {$ENDIF}
  134.  
  135.     InitEvents;
  136.     InitSysError;
  137.  
  138.     HideMouse;
  139.     InitTVVideo;
  140.   end;
  141.  
  142.  
  143.   (*******************************************************************
  144.     Return the directory of the main executable file
  145.     Always ends with a slash or colon...
  146.   *******************************************************************)
  147.   function TToyApp.ExeDir;
  148.     var
  149.       EXEName : PathStr;
  150.       Dir     : DirStr;
  151.       Name    : NameStr;
  152.       Ext     : ExtStr;
  153.   begin
  154.     if Lo(DosVersion)>=3 then
  155.       EXEName:=ParamStr(0)
  156.     else
  157.       EXEName:=FSearch(ExeFileName, GetEnv('PATH'));
  158.     FSplit(EXEName, Dir, Name, Ext);
  159.     ExeDir:=AddBackslash(Dir);
  160.   end;
  161.  
  162.  
  163.   (*******************************************************************
  164.     Help popping and Status line support
  165.   *******************************************************************)
  166.   procedure TToyApp.GetEvent;
  167.   begin
  168.     inherited GetEvent(Event);
  169.  
  170.     if Event.What=evCommand then
  171.     begin
  172.       case Event.Command of
  173.         (* The usual TV help command *)
  174.         cmHelp:          ShowHelp(GetHelpCtx);
  175.         (* These are status line commands and must reside in GetEvent,
  176.            else won't work inside (modal) Help *)
  177.         cmPreviousTopic: ShowHelp(PreviousTopic);
  178.         cmHelpContents:  ShowHelp(hcContents);
  179.         cmHelpOnHelp:    ShowHelp(hcHelpOnHelp);
  180.         else
  181.           Exit;
  182.       end;
  183.       ClearEvent(Event);
  184.     end;
  185.   end;
  186.  
  187.  
  188.   (*******************************************************************
  189.     Standard Help palette
  190.   *******************************************************************)
  191.   function TToyApp.GetPalette;
  192.     const
  193.       CNewColor      = CAppColor      + CHelpColor;
  194.       CNewBlackWhite = CAppBlackWhite + CHelpBlackWhite;
  195.       CNewMonochrome = CAppMonochrome + CHelpMonochrome;
  196.       P : array [apColor..apMonochrome] of String[Length(CNewColor)] =
  197.         (CNewColor, CNewBlackWhite, CNewMonochrome);
  198.   begin
  199.     GetPalette := PPalette(@P[AppPalette]);
  200.   end;
  201.  
  202.  
  203.   (*******************************************************************
  204.     Dos shell must be handled properly:
  205.     CANNOT call inherited HandleEvent first
  206.     To add more default processing, create a new application object
  207.     that inherits TToyApp, add commands, and inherit that instead.
  208.     This eases future upgrades.
  209.   *******************************************************************)
  210.   procedure TToyApp.HandleEvent;
  211.   begin
  212.     if (Event.What=evCommand) and (Event.Command=cmDosShell) then
  213.     begin
  214.       DosShell;                   (* MUST be overridden *)
  215.       ClearEvent(Event);
  216.     end
  217.     else
  218.       inherited HandleEvent(Event);
  219.   end;
  220.  
  221.  
  222.   (*******************************************************************
  223.     Load application palette from stream
  224.   *******************************************************************)
  225.   procedure TToyApp.LoadPalette(var S:TStream);
  226.     var
  227.       P      : TPalette;
  228.       Pal    : Integer;
  229.       OldPal : Integer;
  230.   begin
  231.     OldPal:=AppPalette;
  232.  
  233.     for Pal:=apColor to apMonochrome do
  234.     begin
  235.       S.Read(P[0], 1);
  236.       S.Read(P[1], Length(P));
  237.  
  238.       if S.Status=stOK then
  239.       begin
  240.         AppPalette:=Pal;
  241.         GetPalette^:=P;
  242.       end;
  243.     end;
  244.  
  245.     AppPalette:=OldPal;
  246.   end;
  247.  
  248.  
  249.   (*******************************************************************
  250.     Pop up a (modal) help window, standard TVDEMO style, or
  251.     send message to existing help window
  252.   *******************************************************************)
  253.   procedure TToyApp.ShowHelp;
  254.     var
  255.       W        : PWindow;
  256.       HFile    : PHelpFile;
  257.       HelpStrm : PDosStream;
  258.       Event    : TEvent;
  259.   begin
  260.     (* HelpInUse moved into the Application object *)
  261.     if HelpInUse then
  262.     begin
  263.       Event.What:=evCommand;
  264.       Event.Command:=cmSwitchToTopic;
  265.       Event.InfoWord:=aHelpCtx;
  266.       PutEvent(Event);
  267.     end
  268.     else
  269.     begin
  270.       HelpInUse:=True;
  271.      {$IFDEF ExeHelp}
  272.       HelpStrm:=New(PExeScanningStream, Init(ParamStr(0), stOpenRead, magicHelpFile));
  273.      {$ELSE}
  274.       New(HelpStrm, Init(FSearch(HelpFileName, ExeDir), stOpenRead));
  275.      {$ENDIF}
  276.  
  277.       New(HFile, Init(HelpStrm));
  278.       if HelpStrm^.Status<>stOk then
  279.       begin
  280.         MessageBox(^C'Could not open help file', Nil, mfError+mfOkButton);
  281.         Dispose(HFile, Done);
  282.       end
  283.       else
  284.       begin
  285.         W:=New(PHelpWindow, Init(HFile, aHelpCtx));
  286.         if ValidView(W)<>Nil then
  287.         begin
  288.           W^.HelpCtx:=hcHelpWindow;
  289.           Application^.ExecView(W);
  290.           Dispose(W, Done);
  291.         end;
  292.       end;
  293.       HelpInUse:=False;
  294.     end;
  295.   end;
  296.  
  297.  
  298.   (*******************************************************************
  299.     Store application palette on stream
  300.   *******************************************************************)
  301.   procedure TToyApp.StorePalette(var S:TStream);
  302.     var
  303.       P      : PPalette;
  304.       Pal    : Integer;
  305.       OldPal : Integer;
  306.   begin
  307.     OldPal:=AppPalette;
  308.  
  309.     for Pal:=apColor to apMonochrome do
  310.     begin
  311.       AppPalette:=Pal;
  312.       P:=GetPalette;
  313.       S.Write(P^, Length(P^)+1);
  314.     end;
  315.  
  316.     AppPalette:=OldPal;
  317.   end;
  318.  
  319.  
  320.     (*******************************************************************
  321.     *******************************************************************)
  322.  
  323. end.
  324.